home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / telecomm / bbs / bbbbs84.lha / rexx / bbsOther.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1994-12-21  |  7.6 KB  |  379 lines
  1. /* bbsOther.rexx 8.3 (21.12.94)
  2. copyright © 1994 Richard Lee Stockton
  3. BBBBS display available info about users
  4. FREELY DISTRIBUTABLE
  5. */
  6.  
  7. SIGNAL ON BREAK_C
  8. SIGNAL ON BREAK_E
  9. SIGNAL ON FAILURE
  10. SIGNAL ON SYNTAX
  11.  
  12. PARSE SOURCE . . . prg .
  13. ADDRESS AREXX Increment.rexx prg
  14.  
  15. PARSE ARG maxtime name sysoplevel real bbspath bbsname 
  16.  
  17. IF ADDRESS()='BAUD' THEN
  18.   DO
  19.     CR='0D'x
  20.     frombb=1
  21.   END
  22. ELSE
  23.   DO
  24.     CR=''
  25.     frombb=0
  26.   END
  27. lineup='1B'x'M'
  28.  
  29. userfile=bbspath'Users/'name
  30. CALL OPEN(f,userfile,'R')
  31. data.=''
  32. DO i=1
  33.   line=READLN(f)
  34.   IF EOF(f) THEN LEAVE i
  35.   data.i=line
  36. END
  37. CALL CLOSE(f)
  38. data.0=i-1
  39. IF frombb THEN linesperpage=data.7
  40. ELSE linesperpage=20
  41. clr=''
  42. IF FIND(UPPER(data.8),'CLEAR')>0 THEN clr='0C'x
  43. colorflag=1
  44. IF FIND(data.8,'COLOR')=0 THEN colorflag=0
  45. IF colorflag THEN
  46.   DO
  47.     def=''
  48.     bak2=''
  49.     pen3=''
  50.   END
  51. ELSE
  52.   DO
  53.     def=''
  54.     pen3=''
  55.     bak2=''
  56.   END
  57. level=data.20
  58.  
  59. oprompt='['pen3'D'def']etails or simple ['pen3'N'def']amelist or'
  60. oprompt=oprompt '['pen3'Q'def']uit'
  61. IF level>sysoplevel THEN oprompt=oprompt '['pen3'R'def']eport? (Dnqr) > '
  62. ELSE oprompt=oprompt||'? (Dnq) > '
  63.  
  64. DO FOREVER
  65.   CALL others()
  66. END
  67. EXIT
  68.  
  69.  
  70. others:
  71. line=''
  72. nonstop=0
  73. temp=getinput(1 1 oprompt)
  74. IF temp='Q' THEN EXIT
  75. IF temp='N' THEN
  76.   DO
  77.     CALL showuserlist()
  78.     RETURN
  79.   END
  80. ELSE IF level>sysoplevel & temp='R' THEN
  81.   DO
  82.     SAY CR
  83.     line=''
  84.     IF getinput(1 1 'Report on inactive users? (nY) > ')~='N' THEN
  85.       DO
  86.         CALL cleanline(0)
  87.         SAY 'INACTIVE_USERS report will be in your email.'CR
  88.         line='USERS '
  89.       END
  90.     IF getinput(1 1 'Report on actual files vs. filelists? (nY) > ')~='N' THEN
  91.       DO
  92.         CALL cleanline(0)
  93.         line=line'FILES'
  94.         SAY 'Entering -1 at the next prompt will disable the least popular report.'CR
  95.         line=STRIP(line getinput(1 0 'Report least popular files larger than (0) bytes > '))
  96.         SAY 'FILELISTS_REPORT will be in your email.'CR
  97.       END
  98.     SAY CR
  99.     ADDRESS AREXX bbsREPORT.rexx name line 
  100.     RETURN
  101.   END
  102. SAY CR
  103. SAY 'To allow (or not) other users to see your street address and/or phone number,'CR
  104. SAY 'add (or delete) STREET and/or PHONE to the line 8 list in ['pen3'Y'def']our userfile.'CR
  105. SAY CR
  106. SAY 'User specification may include ? wildcard for single characters.'CR
  107. SAY 'ie,' pen3's?n'def 'will return all user names containing ''son'', ''sen'', ''sin'', etc.'CR
  108. arg=getinput(1 0 pen3'User specification: 'def)
  109. IF arg='' | arg='Q' THEN EXIT
  110. arg=TRANSLATE(STRIP(arg),'_',' ')
  111. SAY 'Searching ...'lineup||CR
  112. CALL FileList(bbspath'Users/*'arg'*',wildlist)
  113. line='Found' wildlist.0 'match'
  114. IF wildlist.0~=1 THEN line=line'es'
  115. SAY line'.'CR
  116. IF wildlist.0<1 THEN RETURN
  117. totlines=0
  118. nextpagebreak=linesperpage-3
  119. extrainfo=0
  120. IF level>sysoplevel THEN
  121.   DO
  122.     IF getinput(1 1 'Display -sysop only- information? (nY) > ')~='N' THEN
  123.       extrainfo=1
  124.   END
  125. DO i=1 TO wildlist.0
  126.   CALL readlines(wildlist.i 1)
  127.   SAY CR
  128.   totlines=totlines+6
  129.   SAY bak2' 'SUBSTR(wildlist.i,LASTPOS('/',wildlist.i)+1)' 'def||CR
  130.   IF real THEN SAY lynes.1||CR
  131.   IF FIND(UPPER(lynes.8),'STREET')>0 THEN
  132.     DO
  133.       totlines=totlines+1
  134.       SAY lynes.2||CR
  135.     END
  136.   SAY lynes.3||CR
  137.   IF FIND(UPPER(lynes.8),'PHONE')>0 THEN
  138.     DO
  139.       totlines=totlines+1
  140.       SAY lynes.4||CR
  141.     END
  142.   SAY 'Last time on' bbsname':' DATE(,WORD(lynes.13,1),'S') WORD(lynes.13,2)||CR
  143.   SAY pen3'Interests:'def lynes.10||CR
  144.   IF extrainfo THEN
  145.     DO
  146.       SAY pen3'   up:'def lynes.14||CR
  147.       SAY pen3' down:'def lynes.15||CR
  148.       temptot=0
  149.       DO j=1 TO WORDS(lynes.23)
  150.         IF DATATYPE(WORD(lynes.23,j),'W') THEN temptot=temptot+WORD(lynes.23,j)
  151.       END
  152.       SAY pen3' writ:'def temptot 'public messages.'CR
  153.       SAY pen3'level:'def lynes.20||CR
  154.       totlines=totlines+4
  155.       IF lynes.21~='' THEN
  156.         DO
  157.           totlines=totlines+1
  158.           SAY pen3'excluded dirs:'def lynes.21||CR
  159.         END
  160.     END
  161.   IF nonstop~=1 & totlines>=nextpagebreak THEN
  162.     DO
  163.       IF waiting2() THEN LEAVE i
  164.       nextpagebreak=totlines+linesperpage-5
  165.     END
  166. END
  167. IF waitchar~='Q' THEN CALL waiting()
  168. RETURN
  169.  
  170.  
  171. checktime:
  172. IF ~frombb THEN RETURN
  173. IF TIME('E')>maxtime THEN EXIT
  174. IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
  175. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  176. CALL checkdcd()
  177. RETURN
  178.  
  179.  
  180. waiting:
  181. CALL checktime()
  182. IF waitchar='Q' THEN
  183.   DO
  184.     waitchar=''
  185.     RETURN
  186.   END
  187. waitchar=''
  188. IF nonstop=1 THEN RETURN
  189. OPTIONS PROMPT pen3'                          RETURN=Continue 'def
  190. PULL waitchar
  191. CALL cleanline(1)
  192. CALL checkdcd()
  193. RETURN
  194.  
  195.  
  196. waiting2:
  197. CALL checktime()
  198. IF nonstop=1 THEN RETURN 0
  199. waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
  200. IF waitchar='N' THEN
  201.   DO
  202.     nonstop=1
  203.     SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def||CR
  204.     SAY CR
  205.     CALL DELAY(99)
  206.     waitchar=''
  207.   END
  208. CALL cleanline(1)
  209. CALL checkdcd()
  210. IF waitchar='Q' THEN RETURN 1
  211. RETURN 0
  212.  
  213.  
  214. readopen:
  215. PARSE ARG fname
  216. ok=OPEN(f,fname,'R')
  217. IF ok~=0 THEN RETURN 1
  218. line=fname 'failed to open for reading!'
  219. SAY line||CR
  220. RETURN 0
  221.  
  222.  
  223. readlines:
  224. CALL CLOSE(f)
  225. PARSE ARG tempname readstart .
  226. IF ~readopen(tempname) THEN RETURN 1
  227. IF readstart<2 THEN lynes.=''
  228. DO ri=readstart
  229.   line=READLN(f)
  230.   IF EOF(f) THEN BREAK
  231.   lynes.ri=line
  232. END
  233. lynes.0=ri-1
  234. CALL CLOSE(f)
  235. DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
  236. END
  237. lynes.0=ri
  238. RETURN 0
  239.  
  240.  
  241. cleanline:
  242. ARG lflag .
  243. IF nonstop=0 & clr~='' & frombb THEN
  244.   DO
  245.     Send clr
  246.     RETURN
  247.   END
  248. IF colorflag~=1 & lflag=1 THEN RETURN
  249. cline=lineup||LEFT(' ',78)
  250. IF lflag=1 THEN cline=cline||lineup
  251. SAY cline||CR
  252. RETURN
  253.  
  254.  
  255. getinput:
  256. PARSE ARG upflag' 'oneflag' 'pline
  257. CALL checkdcd()
  258. OPTIONS PROMPT pline
  259. PARSE PULL inarg
  260. inarg=STRIP(inarg)
  261. IF upflag THEN inarg=UPPER(inarg)
  262. IF oneflag THEN inarg=LEFT(inarg,1)
  263. inarg=cleanstring(inarg)
  264. RETURN inarg
  265.  
  266.  
  267. checkdcd:
  268. IF ~frombb THEN RETURN
  269. dcd
  270. IF RC=0 THEN
  271.   DO
  272.     DO dcds=1 TO 3  /* 5 second delay */
  273.       CALL DELAY(50)
  274.       dcd
  275.       IF RC~=0 THEN RETURN
  276.     END
  277.     dcd
  278.     IF RC=0 THEN EXIT
  279.   END
  280. xmsg=GETCLIP('BBS_MESSAGE')
  281. Capture
  282. IF RC=0 & xmsg~='' THEN
  283.   DO
  284.     CALL SETCLIP('BBS_MESSAGE')
  285.     SAY CR
  286.     SAY bak2' Message From BBBBS: 'def||CR
  287.     SAY xmsg||CR
  288.     SAY CR
  289.     CALL waiting()
  290.   END
  291. IF POS('G',GETCLIP('BBS_COMMAND'))>0 THEN EXIT
  292. RETURN
  293.  
  294.  
  295. cleanstring:
  296. PARSE ARG cstr
  297. bot=XRANGE(,'1F'x)
  298. cstr=strip_ansi(cstr)
  299. top=XRANGE('7F'x)
  300. cstr=COMPRESS(cstr,bot||top)
  301. cstr=STRIP(cstr)
  302. RETURN cstr
  303.  
  304.  
  305. strip_ansi:
  306. PARSE ARG aline 
  307. n=POS('1B'x,aline)
  308. DO WHILE n>0
  309.   DO k=2
  310.     IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
  311.       leave k
  312.   END
  313.   aline=DELSTR(aline,n,k+1)
  314.   n=POS('1B'x,aline)
  315. END
  316. RETURN aline
  317.  
  318.  
  319. seelines:
  320. ARG fancy .
  321. DO i=1 TO lynes.0
  322.   IF fancy=0 THEN SAY lynes.i||def||CR
  323.   ELSE
  324.     DO
  325.       IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
  326.       ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
  327.         SAY pen3||lynes.i||def||CR
  328.       ELSE SAY lynes.i||CR
  329.     END
  330.   IF i//linesperpage=0 & i<lynes.0 THEN
  331.     IF waiting2() THEN LEAVE i
  332. END
  333. nonstop=0
  334. RETURN
  335.  
  336.  
  337. showtext:
  338. PARSE ARG starg .
  339. IF EXISTS(starg) THEN
  340.   DO
  341.     CALL readlines(starg 1)
  342.     CALL seelines(1)
  343.     nonstop=0
  344.     CALL waiting()
  345.   END
  346. RETURN
  347.  
  348.  
  349. showuserlist:
  350. line='   'WORDS(SHOWDIR(bbspath'Users')) 'users. Use these names to address messages.'
  351. SAY pen3||line||def||CR
  352. CALL showtext(bbspath'Lists/USERS')
  353. CALL waiting()
  354. RETURN
  355.  
  356.  
  357. BREAK_E:
  358. i=999999
  359. ri=999999
  360. RETURN
  361.  
  362.  
  363. BREAK_C:
  364. EXIT
  365.  
  366.  
  367. FAILURE:
  368. SYNTAX:
  369. lin.1=''ERRORTEXT(RC)''
  370. lin.2=SIGL-1     SOURCELINE(SIGL-1)
  371. lin.3=SIGL ''SOURCELINE(SIGL)''
  372. lin.4=SIGL+1     SOURCELINE(SIGL+1)
  373. DO er=1 TO 4
  374.   SAY 'bbsOther:' lin.er||CR
  375. END
  376. EXIT
  377.  
  378. /* bbsOther.rexx */
  379.